home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / lisp / ilisp / ilisp-mod.el < prev    next >
Encoding:
Text File  |  1995-01-26  |  5.2 KB  |  165 lines
  1. ;;; -*- Mode: Emacs-Lisp -*-
  2.  
  3. ;;; ilisp-mod.el --
  4.  
  5. ;;; This file is part of ILISP.
  6. ;;; Version: 5.7
  7. ;;;
  8. ;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
  9. ;;;               1993, 1994 Ivan Vasquez
  10. ;;;               1994, 1995 Marco Antoniotti and Rick Busdiecker
  11. ;;;
  12. ;;; Other authors' names for which this Copyright notice also holds
  13. ;;; may appear later in this file.
  14. ;;;
  15. ;;; Send mail to 'ilisp-request@lehman.com' to be included in the
  16. ;;; ILISP mailing list. 'ilisp@lehman.com' is the general ILISP
  17. ;;; mailing list were bugs and improvements are discussed.
  18. ;;;
  19. ;;; ILISP is freely redistributable under the terms found in the file
  20. ;;; COPYING.
  21.  
  22.  
  23.  
  24. ;;;
  25. ;;; ILISP mode top level definitions.
  26. ;;; 
  27.  
  28. ;;;%ilisp-mode
  29.  
  30. (defun ilisp-byte-code-to-list (function)
  31.   "Returns a list suitable for passing to make-byte-code from FUNCTION."
  32.   (let ((function-object 
  33.      (if (symbolp function)
  34.          (symbol-function function)
  35.        function)))
  36.     (nconc
  37.      (list (aref function-object 0)
  38.        (aref function-object 1)
  39.        (aref function-object 2)
  40.        (aref function-object 3))
  41.      (condition-case nil
  42.      (cons (aref function-object 4)
  43.            (condition-case nil
  44.            (list (aref function-object 5))
  45.          (error nil)))
  46.        (error nil)))))
  47.  
  48. ;;;
  49. (defun ilisp-set-doc (function string)
  50.   "Set the documentation of the symbol FUNCTION to STRING."
  51.   (let* ((old-function (symbol-function function)))
  52.     (cond ((listp old-function)
  53.        ;; Probe to test whether function is in preloaded read-only
  54.        ;; memory, and if so make writable copy:
  55.        (condition-case nil
  56.            (setcar old-function (car old-function))
  57.          (error
  58.           (setq old-function (copy-sequence old-function)) ; shallow copy only
  59.           (fset function old-function)))
  60.        (let ((ndoc-cdr (nthcdr 2 old-function)))
  61.          (if (stringp (car ndoc-cdr))
  62.          ;; Replace the existing docstring.
  63.          (setcar ndoc-cdr string)
  64.            ;; There is no docstring.  Insert the overwrite msg.
  65.            (setcdr ndoc-cdr (cons (car ndoc-cdr) (cdr ndoc-cdr)))
  66.            (setcar ndoc-cdr string))))
  67.       (t
  68.        ;; it's an emacs19 compiled-code object
  69.        (let ((new-code (ilisp-byte-code-to-list old-function)))
  70.          (if (nthcdr 4 new-code)
  71.          (setcar (nthcdr 4 new-code) string)
  72.            (setcdr (nthcdr 3 new-code) (cons string nil)))
  73.          (fset function (apply 'make-byte-code new-code)))))))
  74.     
  75.  
  76.  
  77. ;;;
  78. (defun ilisp-mode ()
  79.   (interactive)
  80.   (run-ilisp))
  81.  
  82. (ilisp-set-doc 'ilisp-mode ilisp-documentation)
  83. (ilisp-set-doc 'lisp-mode ilisp-documentation)
  84.  
  85. ;;;%%ILISP
  86. (defun lisp-command-args (string)
  87.   "Break up STRING into (command args ...)."
  88.   (let ((len (length string))
  89.     (position 0)
  90.     (arg 0)
  91.     (args nil))
  92.     (while (< position len)
  93.       (if (eq (aref string position) ?\ )
  94.       (setq args (cons (substring string arg position)  args)
  95.         arg (1+ position)))
  96.       (setq position (1+ position)))
  97.     (setq args (reverse (cons (substring string arg position)  args)))
  98.     args))
  99.  
  100.  
  101.  
  102. ;;;
  103. (defun ilisp (name setup)
  104.   "Run an inferior LISP process NAME, input and output via buffer *name*.
  105. If there is a process already running in *name*, just switch to that buffer.
  106. Takes the program name from the variable ilisp-program.
  107. \(Type \\[describe-mode] in the process buffer for a list of commands.)"
  108.   (set-buffer ilisp-buffer)
  109.   (if (not (comint-check-proc ilisp-buffer))
  110.       (let* ((dialect (car ilisp-dialect))
  111.          (program ilisp-program)
  112.          (args (lisp-command-args program))
  113.          ;; Use pipes so that strings can be long
  114.          (process-connection-type nil)
  115.          (names (format "%s" name))
  116.          start)
  117.     (apply 'make-comint name (car args) nil (cdr args))
  118.     (comint-setup-ipc)
  119.     ;; Because comint-mode kills all buffer-local variables in
  120.     ;; fsf-19 we have to re-call the setup here.
  121.     (funcall setup name)
  122.     (setq major-mode 'ilisp-mode
  123.           mode-name "ILISP")
  124.     (rplaca (car comint-send-queue) 
  125.         (function (lambda ()
  126.                 (run-hooks 'ilisp-init-hook))))
  127.     (setq ilisp-initialized (lisp-del ilisp-buffer ilisp-initialized))
  128.     (if (not (lisp-memk names ilisp-buffers 'car))
  129.         (setq ilisp-buffers (cons (list names) ilisp-buffers)))
  130.     (lisp-pop-to-buffer ilisp-buffer)
  131.     (setq start (window-start (selected-window))
  132.           ilisp-program program)
  133.     (goto-char (point-max))
  134.     (insert (format "Starting %s ...\n" ilisp-program))
  135.     (set-marker (process-mark (ilisp-process)) (point))
  136.     (funcall comint-update-status 'start)
  137.     (if ilisp-motd
  138.         (progn (lisp-display-output (format ilisp-motd ilisp-version))
  139.            (set-window-start (selected-window) start)))
  140.     (if (not ilisp-prefix-match) (require 'completer)))
  141.       (lisp-pop-to-buffer ilisp-buffer))
  142.   (use-local-map ilisp-use-map)
  143.   ;; This is necessary to get mode documentation to come out right
  144.   (set-default 'ilisp-use-map ilisp-use-map))
  145.  
  146.  
  147. ;;;%Manual
  148. (autoload 'fi:clman         "fi/clman" 
  149.       "Look up SYMBOL in the online manual with completion." t)
  150. (autoload 'fi:clman-apropos "fi/clman" 
  151.       "Do an apropos search in online manual for STRING." t)
  152.  
  153. ;;;%Bridges
  154. (autoload 'install-bridge "bridge" "Install process bridge." t)
  155.  
  156. ;;;%Modes
  157. (set-default 'auto-mode-alist
  158.          (append '(("\\.cl$" . lisp-mode) ("\\.lisp$" . lisp-mode))
  159.              auto-mode-alist))
  160. (setq completion-ignored-extensions 
  161.       (append '(".68fasl" ".sfasl" ".ifasl" ".pfasl" 
  162.         ".68fasl4" ".sfasl4" ".ifasl4" ".pfasl4" 
  163.         ".sbin")
  164.           completion-ignored-extensions))
  165.